home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Floppyshop 2
/
Floppyshop - 2.zip
/
Floppyshop - 2.iso
/
art&graf.ix
/
art-0039
/
source
/
myfilese.mod
< prev
next >
Wrap
Text File
|
1997-04-16
|
7KB
|
256 lines
IMPLEMENTATION MODULE MyFileSelector;
(*
This module will 'remember' where you were last time and
show that directory if the pathname is null. If the filename
is null then the filename of *.* is used.
a) File Control.
These are routines that use the standard GEM file selector dialogue.
the information that is required is :-
a path name ( will get current pathname as required )
a file selection mask
the information returned is :-
the current pathname
the file selected
a flag to indicate whether user OK'ed or 'CANCEL'led selection.
*)
(* IMPORT Trace; *)
FROM SYSTEM IMPORT ADR, ADDRESS;
FROM GemDos IMPORT Dgetdrv, Dsetdrv, Dsetpath, Dgetpath;
FROM FileSelect IMPORT fsel_input;
FROM Strings IMPORT String, Concat, Length, Assign
Pos, PosLast, Copy, Delete;
CONST
NULL = 0C;
VAR
LastDrive : ARRAY [ 0 .. 0 ] OF CHAR;
LastDir : String;
PROCEDURE UpperCaseString ( VAR str : ARRAY OF CHAR );
(* UPPER CASE a string in place *)
VAR
i, Aa : CARDINAL;
BEGIN
FOR i := 0 TO SHORT(HIGH( str )) DO
IF ( str[i] >= 'a' )
AND ( str[i] <= 'z' ) THEN
str[i] := CHR( ORD(str[i]) - ORD('a') + ORD('A') );
END; (* if *)
END; (* for *)
END UpperCaseString;
(* remove trailing CR/LF from strings and compress out whitespace *)
PROCEDURE Compress( VAR s : ARRAY OF CHAR );
VAR i, out, len : INTEGER;
PROCEDURE NextChar() : CHAR;
VAR ch : CHAR;
BEGIN
ch := 0C;
WHILE ( i < len )
AND ( s[i] <= ' ' ) DO
INC(i);
END;
IF ( i < len ) THEN ch := s[i] END;
INC(i);
RETURN ch;
END NextChar;
BEGIN (* Compress *)
len := SHORT(HIGH(s)) + 1;
i := 0;
out := 0;
WHILE ( out < len )
AND ( i < len ) DO
s[out] := NextChar();
INC(out);
END;
END Compress;
PROCEDURE NullFill ( VAR s : ARRAY OF CHAR );
VAR c : CARDINAL;
BEGIN
FOR c := 0 TO SHORT(HIGH(s)) DO s[c] := NULL END;
END NullFill;
PROCEDURE GetDefaultDrive() : CARDINAL; (* driveno *)
BEGIN
RETURN Dgetdrv();
END GetDefaultDrive;
PROCEDURE GetDefaultPath ( DefDrive : CARDINAL;
VAR Pathname : ARRAY OF CHAR );
BEGIN
NullFill(Pathname);
Dgetpath( DefDrive, ADR(Pathname) );(* Get current directory on drive *)
Concat(Pathname,'\',Pathname);
END GetDefaultPath;
(*-----------------------------------------------------------------------*)
(* Given a complete pathname then split it up into its constituents. *)
(* a) Drive Letter *)
(* b) Path *)
(* c) filename *)
(* d) extension *)
(*-----------------------------------------------------------------------*)
PROCEDURE ParseFilePath( Pathname : ARRAY OF CHAR;
VAR Drive : ARRAY OF CHAR;
VAR Directory : ARRAY OF CHAR;
VAR Filename : ARRAY OF CHAR;
VAR Extension : ARRAY OF CHAR );
VAR len, posn, firstslashposn, lastslashposn,
dirlen : CARDINAL;
BEGIN
dirlen := 0;
NullFill(Filename); NullFill(Extension); NullFill(Directory);
NullFill(Drive);
Assign('\',Directory);
len := Length(Pathname);
IF len = 0 THEN RETURN END;
(* get drive *)
IF Pathname[1] = ':' THEN
Drive[0] := Pathname[0];
Delete(Pathname, 0, 2 ); (* remove used chars *)
len := Length(Pathname);
IF len = 0 THEN RETURN END;
END;
(* get directory *)
firstslashposn := Pos('\', Pathname, 0 );
IF firstslashposn > 0 THEN
firstslashposn := 0;
END;
lastslashposn := PosLast('\', Pathname, len );
dirlen := (lastslashposn - firstslashposn) + 1
IF lastslashposn < len THEN
Copy(Pathname, firstslashposn, dirlen, Directory);
Delete(Pathname, firstslashposn, dirlen);
ELSE
Assign('\',Directory);
END;
len := Length(Pathname);
IF len = 0 THEN RETURN END;
(* get filename *)
posn := PosLast('.', Pathname, len );
Copy(Pathname, 0, posn, Filename);
IF posn < len THEN
Delete(Pathname, 0, posn+1);
ELSE
Delete(Pathname, 0, posn);
END;
IF Length(Filename) > 8 THEN
Filename[8] := 0C;
END;
len := Length(Pathname);
IF len = 0 THEN RETURN END;
Assign(Pathname, Extension);
IF Length(Extension) > 3 THEN
Extension[3] := 0C;
END;
END ParseFilePath;
(* LastPath ALWAYS contains last last path to use *)
PROCEDURE GetFilename( DefaultExtension : ARRAY OF CHAR;
VAR DefaultPath : ARRAY OF CHAR;
VAR SelectedFilename : ARRAY OF CHAR;
VAR CompleteFilename : ARRAY OF CHAR
) : BOOLEAN ; (* FALSE if cancel *)
VAR
ExitButton : BOOLEAN;
i : INTEGER;
dumc : CARDINAL;
Drive : ARRAY [ 0 .. 0 ] OF CHAR;
Path, s1 : String;
dums, FileSel : String;
BEGIN
UpperCaseString(DefaultExtension);
Compress(DefaultExtension);
UpperCaseString(DefaultPath);
Compress(DefaultPath);
UpperCaseString(SelectedFilename);
Compress(SelectedFilename);
NullFill(CompleteFilename);
(* get drive & path *)
ParseFilePath( DefaultPath, Drive, Path, dums, dums );
IF Drive = 0C THEN
Assign( LastDrive, Drive);
END;
IF Length(DefaultPath) = 0 THEN
Assign(LastDir, Path);
END;
Concat(':', Path, Path);
Concat(Drive, Path, Path); (* drive + directory *)
NullFill(s1)
Assign('*.',s1);
IF Length(DefaultExtension) <> 0 THEN
Concat(s1,DefaultExtension,s1);
ELSE
Concat(s1,'*',s1);
END; (* if *)
Concat(Path,s1,Path);
NullFill( FileSel );
IF ( Length( SelectedFilename ) <= 12 )
AND ( Length( SelectedFilename ) > 0 ) THEN
Assign( SelectedFilename, FileSel );
END; (* if *)
(* Now use standard GEM File Selector Dialoge *)
dumc := fsel_input( Path, FileSel, ExitButton );
(* Set up user filename with returned values *)
Assign( FileSel, SelectedFilename );
(* get info from this select *)
ParseFilePath( Path, Drive, Path, dums, dums );
ParseFilePath( FileSel, dums, dums, FileSel, s1 );
(* Set for next access *)
IF Drive <> 0C THEN
Assign( Drive, LastDrive );
END;
Assign(Path, LastDir);
Concat(':', Path, Path);
Concat(Drive, Path, Path); (* drive + directory *)
Concat('.', s1, s1); (* Filename + Extension *)
Concat(FileSel, s1, FileSel); (* Filename + Extension *)
Concat(Path, FileSel, CompleteFilename);
Assign(Path, DefaultPath);
RETURN( ExitButton & (Length(FileSel) > 0) )
END GetFilename;
BEGIN
LastDrive[0] := CHR(GetDefaultDrive() + ORD('A'));
GetDefaultPath( GetDefaultDrive(), LastDir );
END MyFileSelector.